Unit LazUnitIntf;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, Forms, base64, LCLType, IDECommands, LazIDEIntf, strutils,
    ProjectIntf, MenuIntf, IDEMsgIntf, SrcEditorIntf, IDEWindowIntf, math;

Procedure RunAllTests(Sender: TObject);

Procedure Register;

Implementation

Uses
  BFormLUnitMain, BFormJSONDiffUnit, BFormBeasyLogUnit, BTestProjectManagerUnit;

Function IsMethodLine(Const aLine: String): Boolean;
Const
  stProcedure = 'PROCEDURE';
  stFunction = 'FUNCTION';
  stConstructor = 'CONSTRUCTOR';
  stDestructor = 'DESTRUCTOR';
Begin
  Result := (Pos(stProcedure, UpperCase(aLine)) = 1) Or
      (Pos(stFunction, UpperCase(aLine)) = 1) Or
      (Pos(stConstructor, UpperCase(aLine)) = 1) Or
      (Pos(stDestructor, UpperCase(aLine)) = 1);
End;

Function GetMethodName(Const aLine: String): String;
Var
  aBuffer: SizeInt;
  aIndex: Integer = 80;
Begin
  Result := '';
  If IsMethodLine(aLine) Then
    Begin
      aBuffer := Pos('(', aLine);
      If Not(aBuffer = 0) Then aIndex := Min(aIndex, aBuffer);
      aBuffer := Pos(';', aLine);
      If Not(aBuffer = 0) Then aIndex := Min(aIndex, aBuffer);
      aBuffer := Pos(':', aLine);
      If Not(aBuffer = 0) Then aIndex := Min(aIndex, aBuffer);
      If aIndex < 80 Then Result := Copy(aLine, 1, aIndex - 1);
    End;
End;

Type

{ BTestCheckerClass }

BTestCheckerClass = Class(TThread)
  Private
    Procedure HandleWindow;
  Protected
    Procedure Execute; Override;
  Public
    Constructor Build;
    Destructor Burn;
End;

Var
  TestChecker: BTestCheckerClass = nil;
  TestManager: BTestManagerClass = nil;

Function ActualChecking: Boolean;
Var
  aProject: TLazProject;
  aEditor: TSourceEditorInterface;
Begin
  Result := FALSE;
  aProject := LazarusIDE.ActiveProject;
  aEditor := SourceEditorManagerIntf.ActiveEditor;
  If aProject = nil Then Exit;

  TestManager.SetProject(aProject.MainFile.Filename,
    aProject.LazCompilerOptions.OtherUnitFiles,
    aProject.LazCompilerOptions.CustomOptions);

  LUnitMain.MemoTests.Text := 'Подготовка теста';
  LUnitMain.SetResultColor($008080);
  Result := TRUE;
End;

Procedure AddCurrentFileToTests(Sender: TObject);
Var
  aEditor: TSourceEditorInterface;
Begin
  If Not(ActualChecking) Then Exit;
  aEditor := SourceEditorManagerIntf.ActiveEditor;
  If aEditor = nil Then Exit;
  TestManager.AddTestCase(aEditor.FileName);
  IDEMessagesWindow.BeginBlock;
  IDEMessagesWindow.AddMsg('Добавлено', GetCurrentDir, 0);
  IDEMessagesWindow.EndBlock;
End;

Procedure RunAllTests(Sender: TObject);
Begin
  If Not(ActualChecking) Then Exit;
  If Not(Assigned(LUnitMain)) Then Exit;
  TestManager.Run;
End;

Procedure RunCurrentTestCase(Sender: TObject);
Var
  aEditor: TSourceEditorInterface;
Begin
  If Not(ActualChecking) Then Exit;
  aEditor := SourceEditorManagerIntf.ActiveEditor;
  TestManager.Run(aEditor.FileName);
End;

Procedure RunCurrentTest(Sender: TObject);
Var
  aEditor: TSourceEditorInterface;
  aPoint: TPoint;
  i: LongInt;
  aLine: String;
  aMethod: String;
Begin
  If Not(ActualChecking) Then Exit;
  aEditor := SourceEditorManagerIntf.ActiveEditor;
  aPoint := aEditor.CursorTextXY;
  For i := aPoint.Y DownTo 0 Do
    Begin
      aLine := aEditor.Lines[i];
      If IsMethodLine(aLine) Then
        Begin
          aMethod := GetMethodName(aLine);
          Delete(aMethod, 1, Pos(#32, Trim(aMethod)));
          TestManager.Run(aMethod, TRUE);
          Break;
        End;
    End;
End;

Procedure Workaround(Sender: TObject);
Var
  aEditor: TSourceEditorInterface;
  aErrorIndex: Integer = 100;
  aStringList: TStringList;
  aPoint: TPoint;
  aLine: String;
Begin
  aStringList := TStringList.Create;
  If Not(DirectoryExists(GetAppConfigDir(FALSE))) Then
    MkDir(GetAppConfigDir(FALSE));
  If FileExists(GetAppConfigDir(FALSE) + 'workaround.txt') Then
    aStringList.LoadFromFile(GetAppConfigDir(FALSE) + 'workaround.txt');
  If aStringList.Count = 1 Then
    aErrorIndex := StrToIntDef(aStringList[0], 100) + 1;
  aStringList.Text := IntToStr(aErrorIndex);
  aStringList.SaveToFile(GetAppConfigDir(FALSE) + 'workaround.txt');
  aStringList.Free;
  aEditor := SourceEditorManagerIntf.ActiveEditor;
  aPoint := aEditor.CursorTextXY;
  Try
    aLine := aEditor.CurrentLineText;
    Insert(Format('%d, '#39#39, [aErrorIndex]), aLine, aPoint.X);
    aEditor.CurrentLineText := aLine;
    aPoint.X += 3 + Length(IntToStr(aErrorIndex));
    aEditor.CursorTextXY := aPoint;
  Except
  End;
End;

Procedure PrepareLog(Sender: TObject);
Const
  stBegin = 'BEGIN';
  stEnd = 'END';
Var
  aLines: TStrings;
  aLine, aMethod, aNearLine: String;
  aNeedWrite: Boolean = FALSE;
  aEditor: TSourceEditorInterface;
  i: Integer = 0;
  aBuffer: Integer;
  aCommented: Boolean;
  k: Integer;
  j: Integer;
Begin
  aEditor := SourceEditorManagerIntf.ActiveEditor;
  aEditor.BeginUpdate;
  aLines := aEditor.Lines;
  Try
    While (i < aLines.Count - 1) Do
      Begin
        i += 1;
        aLine := aLines[i];
        If IsMethodLine(aLine) Then
          Begin
            aMethod := GetMethodName(aLine);
            aNeedWrite := TRUE;
          End;
        If (Pos(stBegin, UpperCase(aLine)) = 1) And aNeedWrite Then
          Begin
            aNearLine := aLines[i + 1];
            If (Pos('LogMethodStart', aNearLine) > 0) And
                (Pos('//LogMethodStart', aNearLine) = 0) Then
              aLines.Delete(i + 1);
            If Pos('//LogMethodStart', aNearLine) = 0 Then
              Begin
                aLines.Insert(i + 1,
                  Format('  LogMethodStart(''%s'');', [aMethod]));
                i += 1;
              End;
          End;
        If (Pos(stEnd, upCase(aLine)) = 1) And aNeedWrite Then
          Begin
            j := i;
            For k := 0 To 3 Do
              Begin
                aNearLine := aLines[j];
                If Pos('LogMethodStop(''' + aMethod + ''');',aNearLine) > 0 Then
                  Begin
                    aNeedWrite := FALSE;
                    aCommented := Pos('//LogMethodStop', aNearLine) > 0;
                    aLines.Delete(j);
                    aLines.Insert(j, Format('  %s%sLogMethodStop(''%s'');',
                      [IfThen(k = 1, '', '  '),
                      IfThen(aCommented, '//', ''), aMethod]));
                    i += 1;
                  End;
                If Not(aNeedWrite) Then Break;
                j -= 1;
              End;
            If aNeedWrite Then
              Begin
                aLines.Insert(i, Format('  LogMethodStop(''%s'');', [aMethod]));
                i += 1;
              End;
            aNeedWrite := FALSE;
          End;
      End;
  Except
  End;
  aEditor.EndUpdate;
End;

{ BTestCheckerClass }

Procedure BTestCheckerClass.HandleWindow;
Const
  STR_MAIN = 'ICAoXF8oXAogICggMC5vKQpbOl1cXFxcXFxcXFs6XQogICgiKV9fKCIp';
  STR_MAJOR = 'ICAgICAgLylfLykKICAgICAoby4wICkKWzpdXFxcXFxc' +
      'XFxbOl0KICAgICgiKV9fKCIp';
Var
  i: Integer;
Begin
  LUnitMain.Highlight(TestManager.Successful);
  LUnitMain.MemoTests.Text := TestManager.Output;

  Case Random(10) Of
    0: LUnitMain.MemoTests.Lines.Add(DecodeStringBase64(STR_MAIN));
    1: LUnitMain.MemoTests.Lines.Add(DecodeStringBase64(STR_MAJOR));
  End;

  IDEMessagesWindow.BeginBlock;
  For i := 0 To TestManager.Errors.Count - 1 Do
    IDEMessagesWindow.AddMsg(TestManager.Errors[i], GetCurrentDir, i);
  IDEMessagesWindow.EndBlock;
End;

Procedure BTestCheckerClass.Execute;
Var
  aNeedUpdate: Boolean;
Begin
  Repeat
    Sleep(100);
    If (TestManager.Finished) Then
      Begin
        If aNeedUpdate Then
          Synchronize(@HandleWindow);
        aNeedUpdate := FALSE;
      End
    Else
      aNeedUpdate := TRUE;
  Until Terminated;
End;

Constructor BTestCheckerClass.Build;
Begin
  Inherited Create(FALSE);
End;

Destructor BTestCheckerClass.Burn;
Begin
End;


Procedure CreateFPCUnitWindow(Sender: TObject; aFormName: string;
  Var aForm: TCustomForm; DoDisableAutoSizing: boolean);
Begin
  IDEWindowCreators.CreateForm(LUnitMain, TLUnitMain, DoDisableAutoSizing,
    Application);
  aForm := LUnitMain;
End;

Procedure CreateBEasyFormLogWindow(Sender: TObject; aFormName: string;
  Var aForm: TCustomForm; DoDisableAutoSizing: boolean);
Begin
  IDEWindowCreators.CreateForm(FormBeasyLog, TFormBeasyLog, DoDisableAutoSizing,
    Application);
  aForm := FormBeasyLog;
End;

Procedure CreateJSONDiffWindow(Sender: TObject; aFormName: string;
  Var aForm: TCustomForm; DoDisableAutoSizing: boolean);
Begin
  IDEWindowCreators.CreateForm(FormJSONDiff, TFormJSONDiff, DoDisableAutoSizing,
    Application);
  aForm := FormJSONDiff;
End;

Procedure ShowFPCUnitWindow(Sender: TObject);
Begin
  If Not(Assigned(LUnitMain)) Then LUnitMain := TLUnitMain.Create(LazarusIDE);
  IDEWindowCreators.ShowForm(LUnitMain, TRUE);
End;

Procedure ShowBEasyLogWindow(Sender: TObject);
Begin
  If Not(Assigned(FormBeasyLog)) Then
    FormBeasyLog := TFormBeasyLog.Create(LazarusIDE);
  IDEWindowCreators.ShowForm(FormBeasyLog, TRUE);
End;

Procedure ShowJSONDiffWindow(Sender: TObject);
Begin
  If Not(Assigned(FormJSONDiff)) Then
    FormJSONDiff := TFormJSONDiff.Create(LazarusIDE);
  IDEWindowCreators.ShowForm(FormJSONDiff, TRUE);
End;

Procedure Register;
var
  aKey: TIDEShortCut;
  aCategory: TIDECommandCategory;
  aCmdRunAllTest, aCmdAddCurrentFile, aCmdRunCurrentTestCase: TIDECommand;
  //aLazUnitRun, aLazUnitAdd, aLazUnitShow: TIDECommand;
  aLazUnitMain, aLazUnitSubMenu: TIDEMenuSection;
  aWorkaroundRun, aPrepareLog: TIDECommand;
  aCmdRunCurrentTest: TIDECommand;
begin
  // register IDE shortcut and menu items
  aKey := IDEShortCut(VK_UNKNOWN,[], VK_UNKNOWN, []);
  aCategory := IDECommandList.CreateCategory(nil, 'LazUnit', 'LazUnit',
    IDECmdScopeSrcEditOnly);
  aLazUnitMain := RegisterIDEMenuSection(mnuTools, 'LazUnit');
  aLazUnitSubMenu := RegisterIDESubMenu(aLazUnitMain, 'LazUnit', 'LazUnit', nil,
    nil);

  // create IDE commands
  aCmdAddCurrentFile := RegisterIDECommand(aCategory, 'LazUnitAdd',
    'Add editor file to Tests', aKey, nil, @AddCurrentFileToTests);

  aCmdRunAllTest := RegisterIDECommand(aCategory, 'LazUnitRunAll',
    'Run LazUnit tests', aKey, nil, @RunAllTests);
  aCmdRunCurrentTestCase := RegisterIDECommand(aCategory,
    'LazUnitRunCurrentTestCase', 'Run Current TestCase', aKey, nil,
    @RunCurrentTestCase);
  aCmdRunCurrentTest := RegisterIDECommand(aCategory, 'LazUnitRunCurrentTest',
    'Run Current Test', aKey, nil, @RunCurrentTest);
  aWorkaroundRun := RegisterIDECommand(aCategory, 'LazUnitWorkaround',
    'Add workaround error code', aKey, nil, @Workaround);
  aPrepareLog := RegisterIDECommand(aCategory, 'LazUnitPrepareLog',
    'Add LogMethodStart/Stop pair line in every method', aKey, nil,
    @PrepareLog);


  // create IDE Menu commands
  RegisterIDEMenuCommand(aLazUnitSubMenu, 'LazUnitAdd',
    'Add editor file to Tests', nil, nil, aCmdAddCurrentFile);

  RegisterIDEMenuCommand(aLazUnitSubMenu, 'LazUnitRunAll',
    'Run LazUnit tests', nil, nil, aCmdRunAllTest);
  RegisterIDEMenuCommand(aLazUnitSubMenu, 'LazUnitRunCurrentTestCase',
    'Run Current LazUnit TestCase', nil, nil, aCmdRunCurrentTestCase);
  RegisterIDEMenuCommand(aLazUnitSubMenu, 'LazUnitRunCurrentTest',
    'Run Current LazUnit Test', nil, nil, aCmdRunCurrentTest);
  RegisterIDEMenuCommand(aLazUnitSubMenu, 'LazUnitWorkaround',
    'Add workaround error code', nil, nil, aWorkaroundRun);
  RegisterIDEMenuCommand(aLazUnitSubMenu, 'LazUnitPrepareLog',
    'Add LogMethodStart/Stop pair line in every method', nil, nil, aPrepareLog);

  RegisterIDEMenuCommand(aLazUnitSubMenu, 'ShowFPCUnit',
    'Show FPCUnit Window', nil, @ShowFPCUnitWindow);
  RegisterIDEMenuCommand(aLazUnitSubMenu, 'ShowBEasyLogUnit',
    'Show BEasyLog Window', nil, @ShowBEasyLogWindow);
  RegisterIDEMenuCommand(aLazUnitSubMenu, 'ShowJSONDiff',
    'Show JSON Diff Window', nil, @ShowJSONDiffWindow);

  // create forms
  IDEWindowCreators.Add('LUnitMain', @CreateFPCUnitWindow, nil,
    '100','50%', '+300', '+20%');
  IDEWindowCreators.Add('FormBEasyLog', @CreateBEasyFormLogWindow, nil,
    '100', '50%', '+300', '+20%');
  IDEWindowCreators.Add('LJSONDiff', @CreateJSONDiffWindow, nil,
    '100','50%', '+300', '+20%');

  TestManager := BTestManagerClass.Build;
  TestChecker := BTestCheckerClass.Build;
End;

Finalization
Begin
  If Assigned(TestChecker) Then
    Begin
      TestChecker.Terminate;
      TestChecker.WaitFor;
      TestChecker.Burn;
    End;
End;

End.

